Pascal Super Library/Pascal Super Library (CW International)(1997).bin/MOTOROLA/6805V107/68705VIW.PAS

Pascal/Delphi Source File | 1988-05-06 | 12KB | 381 lines

{The File-Viewer Window module}

Procedure Viewer (Mode : ViewControl);

{****************** Direct File I/O Routines ******************************
 We need direct I/O, since Turbo will not recognise a partial record at the
 end of the file (ie if the character count is not an exact multiple of 256
 bytes. This may be circumvented by direct access via DOS}

var
   dosrec : Regs;

Procedure OpenList;              {Direct OPEN, for Input}
var
   locname : filename;

begin
   locname:= listname + #0;      {ASCIIZ for DOS}
   with dosrec do begin
      DS:= Seg(locname[1]);
      DX:= Ofs(locname[1]);
      AX:= $3d00;                {Open for Read}
      MsDos(dosrec);             {We know it will open}
      ListHandle:= AX;
      end
   end;

Procedure CloseList;             {Direct CLOSE}
begin
   with dosrec do begin
      BX:= ListHandle;
      AX:= $3e00;
      MsDos(dosrec);
      end
   end;

Procedure ReadList (N :integer; var Block : VFdata); {Read 256 bytes at Rec N}
begin
   with dosrec do begin
      BX:= ListHandle;
      AX:= $4200;                 {Seek Record}
      CX:= N shr 8;
      DX:= N shl 8;               {CX:DX = Count of bytes}
      MsDos(dosrec);
      AX:= $3f00;                 {Now Read}
      BX:= ListHandle;
      CX:= VFRmax +1;             {256 bytes}
      DS:= Seg(Block);
      DX:= Ofs(Block);
      MsDos(dosrec);
      end
   end;

Function ListSize : integer;      {No. of 256B records, rounded UP}
begin
   with dosrec do begin
      AX:= $4202;                 {Seek EOF}
      BX:= ListHandle;
      CX:= 0;
      DX:= 0;
      MsDos(dosrec);
      ListSize:= (DX shl 8) + ((AX + $ff) shr 8);
      end
   end;

{**************************************************************************}

const
   null    = 0;                  {Keystroke codes for Viewer commands}
   linup   = 72;                 { They are all Extended sequences}
   linedn  = 80;
   left    = 75;
   right   = 77;
   pgup    = 73;
   pgdn    = 81;
   home    = 71;
   endkey  = 79;
   esckey  = 27;

   pgstep  = 21;                 {No. of line to scroll by Page}

   Function Find (Recnum :integer) :VFptype;     {Virtual-File Reader}
   {The View-file is implemented as a "virtual file" of records stored in the
    Heap. These records are accessed using a simple hashing algorithm (which
    exploits the locality properties of this application), by this routine.
    The routine returns a pointer to the Heap_record required.}

   var
      access : integer;

   begin
      access:= recnum mod (MaxCtl+1);             {The hashing function}
      with VFControl[access] do begin
         if (VFrecno <> Recnum) then begin        {Need to read a new record}
            if (VFptr = nil) then new(VFptr);     {Get a buffer, if reqd.}
            VFrecno:= Recnum;                     {This record, now}
            with VFptr^ do
               ReadList(Recnum, VFinfo);          {Direct seek & read}
            end;
         Find:= VFptr;
         end
      end;

   Function Same(a, b :VFPosn) :boolean;  {Test if 2 pointers equivalent}
   begin
      Same:= (a[Recordnum] = b[Recordnum]) and
             (a[PosinRecd] = b[PosinRecd]);
      end;

   Function Below(a, b :VFPosn) : boolean;
            {Returns TRUE if 'a' is BELOW 'b' in file}
   begin
      Below:= a[Recordnum] > b[Recordnum];
      if a[Recordnum] = b[Recordnum] then
         Below:= a[PosinRecd] > b[PosinRecd];
      end;

   Procedure BackOnce (var x : VFPosn);  {Backs up 1 char.}
   begin
      if x[PosinRecd] =0 then begin      {Does NOT check for TOF}
         x[PosinRecd]:= VFRmax;
         x[Recordnum]:= x[Recordnum] -1;
         end
      else
         x[PosinRecd]:= x[PosinRecd] -1;
      end;

   Procedure FwdOnce (var x : VFPosn);   {Advance 1 char. only}
   begin
      if x[PosinRecd] < VFRmax then         {Does NOT check for EOF}
         x[PosinRecd]:= x[PosinRecd] +1
      else begin
         x[PosinRecd]:= 0;
         x[Recordnum]:= x[Recordnum] +1;
         end
      end;

   Function Data(a : VFPosn) : byte;     {Returns the designated data byte}
   var
      Rptr : VFptype;

   begin
      Rptr:= Find( a [Recordnum]);       {Get the data record}
      with Rptr^ do
         Data:= VFinfo[ a[PosinRecd]];
      end;

   Procedure Backup(var a : VFPosn; N : integer);
            {Backs-up 'a', N lines - checks for TOF}
   begin
      while ((N > 0) and below(a,TopFile)) do begin
         BackOnce(a);
         if not Same(a,TopFile) then begin
            repeat
               BackOnce(a);
               until Same(a,TopFile) or (Data(a) = ord(CR));
            end;
         if not Same(a,TopFile) then begin
            FwdOnce(a);
            N:= N-1;
            end
         end
      end;

Procedure Advance (               {Advance ptr N lines, optionally display}
                   var a : VFPosn;     {File Pointer}
                       N,              {No. of lines to move}
                 Scrline : integer );  {Screen line to OP (or -1) }
var
   outcol : integer;                   {Logical output-col. no.}
     this : char;                      {Current char.}

   procedure sendit(x :char);          {Send "x" to CRT}
   var
      loccol : integer;

   begin
      loccol:= outcol - ColumnOffset + windsep +1;
      if (windsep < loccol) and (80 >= loccol) then
         CRTbase^[Scrline,loccol,character]:= ord(x);
      outcol:= outcol+1;
      end;

begin
   while ((N >0) and Below(BtmFile,a)) do begin
      outcol:= 0;
      if (Scrline >= 0) then begin     {If we output, clear line}
         gotoxy(1,Scrline);
         clreol;
         end;
      repeat                           {Do 1 line}
         this:= chr(Data(a));          {Get a byte}
         if (Scrline >= 0) then begin  {If displaying it...}
            if this = TAB then repeat  {Expand TABs}
               sendit(' ');
               until (outcol mod 8) =0
            else if this >= ' ' then sendit(this);
            end;
         FwdOnce(a);                   {Advance file}
         until (this = CR) or (not Below(BtmFile,a));
      N:= N-1;
      if Scrline > 0 then Scrline:= Scrline +1;
      end
   end;

procedure Perform (x :byte);                 {Perform the various functions}
var
   tempoint : VFPosn;
   linectr  : integer;

   procedure Showit(Toppoint :VFPosn);       {Non-destructive display}
   begin                                     {Sets new BotScreen}
      clrscr;
      BotScreen:= Toppoint;
      Advance(BotScreen,lastline,1);
      end;

   procedure Uponce;
   begin                        {Up One Line}
      if below(TopScreen,TopFile) then begin
         gotoxy(1,1);
         insline;               {Scroll down once}
         Backup(TopScreen,1);
         Backup(BotScreen,1);
         tempoint:= TopScreen;
         Advance(tempoint,1,1);
         end
      end;

   procedure Downonce;
   begin                        {Down One Line}
      if below(BtmFile,BotScreen) then begin
         gotoxy(1,1);
         delline;
         Advance(TopScreen,1,-1);
         Advance(BotScreen,1,lastline);
         end
      end;

begin
   highvideo;
   case x of
      linup   : Uponce;                              {Up One Line}

      linedn  : Downonce;                            {Down One Line}

      left    : begin                                {16 Columns Left}
                   if ColumnOffset >= 16 then begin
                      ColumnOffset:= ColumnOffset -16;
                      Showit(TopScreen);
                      end
                   end;

      right   : begin                                {16 Columns Right}
                   ColumnOffset:= ColumnOffset +16;
                   Showit(TopScreen);
                   end;

      pgup    : for linectr:= 1 to 21 do Uponce;     {21 Lines Up}

      pgdn    : for linectr:= 1 to 21 do Downonce;   {21 Lines Down}

      home    : begin                                {Top of File}
                   TopScreen:= TopFile;
                   ColumnOffset:= 0;
                   Showit(TopScreen);
                   end;

      endkey  : begin                        {End of File}
                   TopScreen:= EndScreen;
                   ColumnOffset:= 0;
                   Showit(TopScreen);
                   end;
      end
   end;



Procedure ViewInitz;                   {Start up the Viewer}
var
   ptr     : integer;
   lastrec : VFptype;

begin
   OpenList;                           {Direct OPEN on Listing File}
   FirstView   := true;                {Set up variables}
   ColumnOffset:= 0;
   for ptr:= 0 to MaxCtl do
      with VFControl[ptr] do begin
         VFptr  := nil;                {Clean out the Control Table}
         VFrecno:= -1;
         end;
   TopFile[Recordnum]:= 0;             {Set up file pointers}
   TopFile[PosinRecd]:= 0;
   BtmFile[Recordnum]:= ListSize -1;
   lastrec:= Find(BtmFile[Recordnum]); {Read the final record}
   with lastrec^ do begin
      ptr:= 0;
      repeat                           {Locate the final CR}
         if VFinfo[ptr] =ord(CR) then BtmFile[PosinRecd]:= ptr;
         ptr:= ptr+1;
         until ((ptr > VFRmax) or (VFinfo[ptr] =ord(ENDFILE)));
      end;
   if BtmFile[PosinRecd] < VFRmax then  { Now point BtmFile at true EOF}
      BtmFile[PosinRecd] := BtmFile[PosinRecd] +1;
   EndScreen:= BtmFile;
   Backup(EndScreen, lastline);    {Final top-of-screen locn.}
   end;

Procedure ViewTheFile;           {The main Viewing Function}
   Procedure DoViewCmnd (firstcmnd : byte);    {Do a command}
   var
      dothis : byte;                {The command to do}

      function viewcmnd : byte;        {Get/validate Command}
      const
         extncommands : set of byte =[ null,   linup,  linedn, left,   right,
                                       pgup,   pgdn,   home,   endkey];
      var
         keyc : char;
         extn : boolean;

      begin
         repeat
            read(kbd,keyc);                       {Get some key}
            extn:= keypressed and (keyc = ESC);
            if extn then read(kbd,keyc);          {Get extended key, if any}
            until ((extn and (ord(keyc) in extncommands)) or
                  ((not extn) and (keyc = ESC)));
         viewcmnd:= ord(keyc);
         end;                          {of Function VIEWCMND}

   begin                            {Main body of DoViewCmnd}
      dothis:= firstcmnd;
      repeat
         Perform (dothis);          {Perform the command}
         dothis:= viewcmnd;         {Next one}
         until dothis = esckey;
      end;                          {of Procedure DOVIEWCMND}

const
   brp1 = '{|X|Y} Line ~: {|[|Z} 16 cols ~: ';
   brp2 = '{PgUp PgDn} Screen ~: {Home} Start ~: ';
   brp3 = '{End} Bottm ~: {ESC}=Emulate';

begin                            {Main body of ViewTheFile}
   window(1,1,80,25);
   savewindow(debugwind);
   promptline(brp1 + brp2 + brp3);
   if FirstView then begin
      FirstView:= false;         {Draw it the first time}
      firstscreen;
      DoViewCmnd (home);
   end
   else begin
      showwindow(viewind);
      DoViewCmnd (null);
      end;
   savewindow(viewind);
   pulldebug(true);              {Then get DEBUG back}
   end;

Procedure ViewFinish;            {Done Viewing - Clean up}
var
   ptr : integer;

begin
   CloseList;
   for ptr:= 0 to MaxCtl do
      with VFcontrol[ptr] do
         if (VFptr <> nil) then dispose(VFptr);
   end;

begin
   case Mode of
      Initz  : ViewInitz;
      View   : ViewTheFile;
      Finish : ViewFinish;
      end
   end;